home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / program / ctlib100.zip / INSTALL.LZH / ARRAYSH5.PAS < prev    next >
Pascal/Delphi Source File  |  1996-10-12  |  4KB  |  146 lines
  1. {**************************************************************************}
  2. {*  BitSoft Development, L.L.C.                                           *}
  3. {*  Copyright (C) 1995, 1996 BitSoft Development, L.L.C.                  *}
  4. {*  All rights reserved.                                                  *}
  5. {*  Containers Library demo                                               *}
  6. {**************************************************************************}
  7.  
  8. program ArraysHuge5;
  9.  
  10. {$X+}
  11.  
  12. { Sample program for using a huge resizable array }
  13.  
  14. uses Containr, ctArrays,
  15.      {$ifdef Windows}
  16.      WinCtr;
  17.      {$else}
  18.      Crt;
  19.      {$endif}
  20.  
  21. type
  22.   PContact = ^TContact;
  23.   TContact = record
  24.     FirstName : string[15];
  25.     LastName : string[20];
  26.     Phone : string[18];
  27.     Company : string [25];
  28.   end; { TContact }
  29.  
  30. procedure SetContactValues(ALastName, AFirstName, APhone,
  31.   ACompany : string; var ContactRec : TContact);
  32. begin
  33.   with ContactRec do
  34.   begin
  35.     FirstName := AFirstName;
  36.     LastName := ALastName;
  37.     Phone := APhone;
  38.     Company := ACompany;
  39.   end; { with }
  40. end;
  41.  
  42. procedure DisplayContacts(ContactList : PSequence);
  43.  
  44.   procedure PrintInfo (Item : Pointer); far;
  45.   begin
  46.     with PContact(Item)^ do
  47.       writeln(LastName, '':15 - Length(LastName),
  48.         FirstName, '':15 - Length(FirstName),
  49.         Phone, '':20 - Length(Phone),
  50.         Company, '':20 - Length(Company));
  51.   end;
  52.  
  53. begin
  54.   ContactList^.ForEach(@PrintInfo);
  55. end;
  56.  
  57. procedure DisplayFirst(ContactList : PSequence);
  58. var
  59.   Item : Pointer;
  60.   Index : LongInt;
  61. begin
  62.   Item := ContactList^.First(Index);
  63.   Writeln('First item:');
  64.   with PContact(Item)^ do
  65.     writeln(LastName, '':15 - Length(LastName),
  66.       FirstName, '':15 - Length(FirstName),
  67.       Phone, '':20 - Length(Phone),
  68.       Company, '':20 - Length(Company));
  69.   ContactList^.DoneItem(Item); { not required }
  70. end;
  71.  
  72. procedure DisplayLast(ContactList : PSequence);
  73. var
  74.   Item : Pointer;
  75.   Index : LongInt;
  76. begin
  77.   Item := ContactList^.Last(Index);
  78.   Writeln('Last item:');
  79.   with PContact(Item)^ do
  80.     writeln(LastName, '':15 - Length(LastName),
  81.       FirstName, '':15 - Length(FirstName),
  82.       Phone, '':20 - Length(Phone),
  83.       Company, '':20 - Length(Company));
  84.   ContactList^.DoneItem(Item); { not required }
  85. end;
  86.  
  87. procedure FindLastName(ContactList : PSequence; LastName : string);
  88. var
  89.   Item : Pointer;
  90.   Index : LongInt;
  91.  
  92.   function MatchLastName (Item : Pointer): boolean; far;
  93.   begin
  94.     MatchLastName := (LastName = PContact(Item)^.LastName);
  95.   end;
  96.  
  97. begin
  98.   Item := ContactList^.FirstThat(@MatchLastName, Index);
  99.   Writeln('Item found with last name ''', LastName, ''':');
  100.   with PContact(Item)^ do
  101.     writeln(LastName, '':15 - Length(LastName),
  102.       FirstName, '':15 - Length(FirstName),
  103.       Phone, '':20 - Length(Phone),
  104.       Company, '':20 - Length(Company));
  105.   ContactList^.DoneItem(Item); { not required }
  106. end;
  107.  
  108. var
  109.   ContactList : PResizableHugeArray;
  110.   Contact : TContact;
  111.  
  112. begin
  113.   ClrScr;
  114.  
  115.   { Create the array }
  116.   ContactList := New(PResizableHugeArray, Init(50, 10,  SizeOf(TContact)));
  117.  
  118.   { Insert the items in the array }
  119.   with ContactList^ do
  120.   begin
  121.     SetContactValues('Lewis', 'Carl', '(506) 83-780', 'Running, Corp.',
  122.       Contact);
  123.     Insert(@Contact);
  124.     SetContactValues('Benton', 'Michael', '(403) 33-973', 'ER, Inc.',
  125.       Contact);
  126.     Insert(@Contact);
  127.     SetContactValues('Wagner', 'Robert', '(906) 11-230', 'Symphony, Ltd.',
  128.       Contact);
  129.     Insert(@Contact);
  130.     SetContactValues('Smith', 'John', '(656) 75-843', 'InterComm, Corp.',
  131.       Contact);
  132.     Insert(@Contact);
  133.   end; { with }
  134.  
  135.   DisplayContacts(ContactList);
  136.   Writeln;
  137.   DisplayFirst(ContactList);
  138.   Writeln;
  139.   DisplayLast(ContactList);
  140.   Writeln;
  141.   FindLastName(ContactList, 'Wagner');
  142.  
  143.  
  144.   { Dispose of the array }
  145.   Dispose(ContactList, Done);
  146. end.